;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
;;;
;;; qt-renderer.lisp --- QT and OpenGL.
;;;
;;; Copyright (C) 2011, John Miller  <JohnPantagruel@gmail.com>
;;;   All rights reserved.
;;;

(in-package :dreaming-tree)
(use-package :qt)
;(defpackage :qt-user
;  (:use :cl :qt :iterate :lib.gl)
;  (:export :run-qt-app))

;(in-package :qt-user)
(named-readtables:in-readtable :qt)

(defparameter *qapp* nil)
(defparameter *qthread* nil)

;;;; Utilities ;;;;

(defmacro define-qslot-setter (accessor class update-signal &body actions)
  (alexandria:with-gensyms (oldval newval)
    (unless (or (null update-signal) (string= update-signal ""))
      (setf actions (append actions (list `(emit-signal instance ,update-signal ,newval)))))
    `(defmethod (setf ,accessor) :around (,newval (instance ,class))
       (let ((,oldval (,accessor instance)))
	 (prog1
	     (call-next-method)
	   (unless (eql ,oldval ,newval)
	     ,@actions))))))

;;;; OpenGL Widgets

(defparameter *simple-vertex-shader* "#version 330
in vec4 position;
in vec4 color;
out vec4 theColor;
uniform vec2 offset;

void main(void)
{
   gl_Position = (position + (vec4(offset.x, offset.y, 0.0, 0.0)));
   theColor = color;
}")

(defparameter *simple-fragment-shader* "#version 330
in vec4 theColor;

void main()
{
   gl_FragColor = theColor;
}")

(defshader :vertex "330" simple-offset ((:in (vec4 position)
					     (vec4 color))
					(:out (vec4 the-color))
					(:uniform (vec2 offset)))
  (defun :void main ()
	 (setq gl-position (+ position (vec4 offset.x offset.y 0.0 0.0)))
	 (setq the-color color)))

(defshader :fragment "330" simple-offset ((:in (vec4 the-color)))
  (defun :void main ()
	 (setq gl-fragcolor the-color)))

(defparameter *vertex-positions*
  (make-array 12 :initial-contents '(0.75 0.75 0.0 1.0 
				     0.75 -0.75 0.0 1.0
				     -0.75 -0.75 0.0 1.0)))

(defparameter *vdata*
  (make-array 24 :element-type 'single-float
	      :initial-contents
	      '(0.0 0.5 0.0 1.0
		0.5 -0.366 0.0 1.0
		-0.5 -0.366 0.0 1.0
		1.0 0.0 0.0 1.0
		0.0 1.0 0.0 1.0
		0.0 0.0 1.0 1.0)))

(defparameter *active-glviews* nil)

(defclass glview ()
  ((vbuf :accessor vertex-buffer :initform nil)
   (shader :accessor shader :initform nil)
   (offset-loc :accessor offset-loc :initform nil)
   (offset-vec :accessor offset-vec :initform #(0.0 0.0 0.0))
   (taccum :accessor taccum :initform 0.0)
   (timer :accessor timer :initform nil))
  (:metaclass qt:qt-class)
  (:qt-superclass "QGLWidget")
  (:slots ("void computePositionOffsets()" compute-position-offsets))
  (:override ("initializeGL" initialize-gl)
	     ("paintGL" paint-gl)
	     ("resizeGL" resize-gl)))

(defmethod initialize-instance :after ((instance glview) &rest initargs)
  (declare (ignore initargs))
  (new instance))

(defmethod initialize-gl ((widget glview))
  (push widget *active-glviews*)
  (with-slots (vbuf shader timer) widget
    (setf shader (lib.gl:compile-and-link-shader 'simple-offset))
;    (setf shader (lib.gl::load-shader-pair-with-attributes *simple-vertex-shader* *simple-fragment-shader*))
;    (when (lib.gl::get-shader-source-pair 'matrix-perspective)
;      (format t "Compiled and linked shader prog with id:~A~%" (lib.gl::compile-and-link-shader 'lib.gl::matrix-perspective)))
    (setf (offset-loc widget) (gl:get-uniform-location shader "offset"))
    (format t "GLSL Version: ~A~%" (gl:get-string :shading-language-version))
    (gl:clear-color 0.0 0.0 0.0 1.0)
    (setf vbuf (new-buffer *vdata* :target :array-buffer :usage :static-draw))
  ;; (lib.gl::with-opengl-array (bufdata '%gl:float *vdata*)
  ;;     (gl:clear-color 0.0 0.0 0.0 1.0)
  ;;     (setf vbuf (car (gl:gen-buffers 1)))
  ;;     (gl:bind-buffer :array-buffer vbuf)
  ;;     (gl:buffer-data :array-buffer :static-draw bufdata)
  ;;     (gl:bind-buffer :array-buffer 0))
    ;; Initialize animation loop
    (setf timer (#_new QTimer))
    (#_connect "QObject" timer (QSIGNAL "timeout()")
	       widget (QSLOT "computePositionOffsets()"))
    (#_start timer 25)))

(defmethod compute-position-offsets ((self glview))
  (with-slots (offset-vec taccum timer) self
    (incf taccum (/ (#_interval timer) 1000.0)) ;; Yuck!
    (let* ((loop-duration 5.0)
	   (scale (/ (* pi 2.0) loop-duration))
	   (time-through-loop (mod taccum loop-duration)))
      (setf offset-vec (make-vector (* 0.5 (cos (* time-through-loop scale)))
				    (* 0.5 (sin (* time-through-loop scale)))))
      (#_updateGL self))))

(defmacro with-glcontext (qt-context &body body)
  `(unwind-protect
	(progn (#_makeCurrent ,qt-context)
	       ,@body)
     (#_doneCurrent)))

#| The fixed function pipeline
(defmethod paint-gl ((widget glview))
  ;(format t "In paint-gl.~%")
  (gl:clear :color-buffer-bit :depth-buffer-bit)
  (gl:color 1 1 1)
  (gl:with-primitive :polygon
    (gl:vertex 0.25 0.25 0)
    (gl:vertex 0.75 0.25 0)
    (gl:vertex 0.75 0.75 0)
    (gl:vertex 0.25 0.75 0))
  ;; Start processing buffered OpenGL routines.
  (gl:flush))
|#

;; The future - Science!

(defmethod paint-gl ((widget glview))
  (gl:clear :color-buffer-bit)
  (gl:use-program (shader widget))
  (gl:uniformf (offset-loc widget) 
	       (x (offset-vec widget))
	       (y (offset-vec widget)))
  (enable-buffer (vertex-buffer widget))
  (gl:enable-vertex-attrib-array 0)
  (gl:enable-vertex-attrib-array 1)
  (gl:vertex-attrib-pointer 0 4 :float :false 0 (cffi:null-pointer))
  (gl:vertex-attrib-pointer 1 4 :float :false 0 (cffi:make-pointer 48))
  (gl:draw-arrays :triangles 0 3)
  (gl:disable-vertex-attrib-array 0)
  (gl:disable-vertex-attrib-array 1)
  (gl:use-program 0)
  (gl:flush))

(defmethod resize-gl ((widget glview) width height)
  (let ((side (min width height)))
    (gl:viewport (/ (- width side) 2)
		 (/ (- height side) 2)
		 side
		 side)
    (gl:matrix-mode :projection)
    (gl:load-identity)
    (gl:ortho 0 1 0 1 -1 1)))

(defun run-glview (&optional style)
  (ensure-smoke :qtcore)
  (ensure-smoke :qtgui)
  (ensure-smoke :qtopengl)
  (when style
    (#_setStyle "QApplication"
		(#_create "QStyleFactory" (ecase style
					    (:cde "CDE")
					    (:macintosh "Macintosh")
					    (:windows "Windows")
					    (:motif "Motif")))))
  (setf *qapp* (ensure-qapplication))
  (let* ((window (make-instance 'glview))
	 (context (#_context window)))
    (setf %gl::*gl-get-proc-address* #'(lambda (proc-string)
					 (#_getProcAddress context proc-string)))
    (#_show window)
    (unwind-protect
	 (#_exec *qapp*)
      (#_hide window))))

;;;;
;;; Running QT windows in separate threads

(defparameter *qt-test-thread* nil)

(defun test-threading (test-fn)
  (setf *qt-test-thread* (ccl:process-run-function "Qt Application Test Thread" test-fn)))

(defun test-threading-fn-1 ()
  (ensure-smoke :qtcore)
  (ensure-smoke :qtgui)
  (let ((instance (#_QCoreApplication::instance)))
    (format t "Created instance ~A.~%" instance)))

(defun test-threading-fn-2 ()
  (setf *qapp* (ensure-qapplication))
  (let ((window (make-instance 'glview)))
    (unwind-protect
	 (#_exec *qapp*)
      (format t "Exiting...~%0"))))

;;;;
;;;

